VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MenuSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' SG Window message callback interface
Implements sgWindow.IsgMessageSink

' SG Window object
Private mclsWindow As sgWindow.Window

' MenuSelect Events
Public Event MenuItemSelected(Caption As String)

' API declarations
Private Declare Function GetMenuString Lib "user32" Alias _
   "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, _
   ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
   
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400&

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, _
   lpMenuItemInfo As MENUITEMINFO) As Long

Public Property Let hWnd(ByVal vData As Long)
   mclsWindow.hWnd = vData
   If vData <> 0 Then
      mclsWindow.Hooked = True
      mclsWindow.EnableMessage wm_MENUSELECT
   Else
      mclsWindow.Hooked = False
      mclsWindow.EnableMessage wm_MENUSELECT, False
   End If
End Property

Public Property Get hWnd() As Long
    hWnd = mclsWindow.hWnd
End Property

Private Sub Class_Initialize()
   Set mclsWindow = New sgWindow.Window
   mclsWindow.SetMessageCallback Me
End Sub

Private Sub Class_Terminate()
   Set mclsWindow = Nothing
End Sub


' Message handler.
' This method is called when WM_MENUSELECT message arrives
' in the attached window message queue. Window Message
' is than translated into the MenuItemSelected event
Private Sub IsgMessageSink_Message(ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
   Dim sCaption As String * 255
   Dim iPos%
   
   'get menu item caption
   GetMenuString lParam, sgWindow.LowWord(wParam), _
      sCaption, 255, sgWindow.HighWord(wParam)
   '---todo--------------------------------
   Dim mi As MENUITEMINFO
   
   GetMenuItemInfo lParam, 0, False, mi
   '---todo--------------------------------
   Debug.Print mi.dwTypeData
   'check out if menu has shortcut
   iPos = InStr(sCaption, vbTab)
   
   If iPos > 0 Then
      'cut shortcut out
      sCaption = Left$(sCaption, iPos - 1)
   Else
      'remove null chars from string
      sCaption = Left$(sCaption, InStr(sCaption, Chr(0)) - 1)
   End If
   
   'remove '&' char
   sCaption = String_StripChar(sCaption, "&")
   
   RaiseEvent MenuItemSelected(sCaption)
End Sub

Private Function String_StripChar(ByVal sOrig As String, sChar As String) As String
   Dim Pos As Integer
   Dim iLen As Integer

   On Error Resume Next
   
   iLen = Len(sOrig)
   If iLen > 0 Then
      Pos = InStr(sOrig, sChar)
      Do While (Pos > 0)
         If (Pos <= iLen) Then
            sOrig = VBA.Left$(sOrig, Pos - 1) + VBA.Right$(sOrig, iLen - Pos)
            iLen = iLen - 1
         End If
         Pos = InStr(sOrig, sChar)
      Loop
   End If
   String_StripChar = sOrig
End Function


